From 788de39262809040ebf1096aff22190ad526dc1b Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Sat, 27 Jan 2024 23:04:26 +0300
Subject: Rewrite, version 0.2: use Parsec, focus on DSV

---
 Coalpit.hs | 595 +++++++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 544 insertions(+), 51 deletions(-)

(limited to 'Coalpit.hs')

diff --git a/Coalpit.hs b/Coalpit.hs
index edbade0..0eec909 100644
--- a/Coalpit.hs
+++ b/Coalpit.hs
@@ -5,61 +5,554 @@ Stability   :  unstable
 Portability :  non-portable (uses GHC extensions)
 
 Coalpit is a library for building command-line interfaces: the goal is
-to get interfaces quickly and easily, while keeping them
-language-agnostic and more user- and shell scripting-friendly than
-JSON and similar formats.
+to build interfaces quickly and easily (by deriving those), while
+keeping them language-agnostic and more user- and shell
+scripting-friendly than JSON and similar formats.
 
+-}
+
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
-== Example
+module Coalpit ( fromDSV
+               , fromDSVList
+               , toDSV
+               , toDSVList
+               , dsvFromList
+               , Coalpit(..)
+                 -- * Usage
+               , usage
+               , usageString
+               , Usage(..)
+                 -- * Options
+               , SelNamePolicy(..)
+               , Options(..)
+               , defOpt
+               ) where
 
-@
-\{\-\# LANGUAGE DeriveGeneric, DeriveAnyClass \#\-\}
 import GHC.Generics
-import Data.Proxy
-import System.Environment
-import Coalpit
-
-data Foo = Foo { bar :: Maybe Int
-               , baz :: String
-               } deriving (Show, Generic, 'Coalpit')
-
-main :: IO ()
-main = do
-  args <- getArgs
-  case 'fromArgs' 'defOpt' args of
-    Left err -> do
-      putStrLn err
-      putStrLn $ "Usage: " ++ 'usageString' 'defOpt' (Proxy :: Proxy Foo)
-    Right x -> do
-      print (x :: Foo)
-      print $ 'toArgs' 'defOpt' x
-      putStrLn $ showDSV defOpt x
-      print ('readDSV' 'defOpt' $ 'showDSV' 'defOpt' x :: Either String Foo)
-@
-
-Then, in a shell:
-
-> $ ./Example 'a string'
-> Foo {bar = Nothing, baz = "a string"}
-> ["a string"]
-> "a string"
-> Right (Foo {bar = Nothing, baz = "a string"})
-> $ ./Example --bar 42 'a string'
-> Foo {bar = Just 42, baz = "a string"}
-> ["--bar","42","a string"]
-> --bar 42 "a string"
-> Right (Foo {bar = Just 42, baz = "a string"})
-> $ ./Example --bar foo
-> arguments:1:3:
-> Failed to read: foo
->
-> Usage: [--bar INT] STRING
+import Text.Parsec
+import Text.Parsec.String
+import Data.Char (toLower)
+import Data.Proxy (Proxy(..))
+import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.List (intercalate)
+import Data.Word (Word8, Word16, Word32, Word64)
+import Numeric.Natural (Natural)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Time.Clock (DiffTime, NominalDiffTime, UniversalTime, UTCTime)
+import Data.Time.Format ( TimeLocale, formatTime
+                        , iso8601DateFormat, defaultTimeLocale
+                        , ParseTime, readSTime)
+import Data.Time.Calendar (Day)
+import Data.Time.LocalTime (TimeOfDay, LocalTime, ZonedTime)
+import Data.Scientific (Scientific, FPFormat(..), formatScientific, scientificP)
+import Text.ParserCombinators.ReadP (readP_to_S)
+import Data.Complex (Complex)
+import Data.Version (Version, parseVersion, showVersion)
+import System.Exit (ExitCode)
+import Network.URI (URI, parseURIReference, uriToString)
 
--}
+-- | Usage description: can be translated into help messages or
+-- documentation formats.
+data Usage = UConstructor String
+           -- ^ Data constructor.
+           | URecursive String
+           -- ^ Constructor of a recursive data structure (its second
+           -- appearance in the tree).
+           | USelector Bool String Usage
+           -- ^ Record selector.
+           | UOptional Usage
+           -- ^ Optional element.
+           | USum Usage Usage
+           -- ^ Sum.
+           | UProduct Usage Usage
+           -- ^ Product.
+           | UUnit
+           -- ^ Unit.
+           | UType String
+           -- ^ Type name (e.g., \"INT\").
+           deriving (Show)
 
-module Coalpit ( module Coalpit.Core
-               , module Coalpit.DSV
-               ) where
+-- | How to handle selector names.
+data SelNamePolicy = SNDisable
+                   -- ^ Do not parse or print selector names
+                   | SNAvoid
+                   -- ^ Allow selector names on parsing, but do not
+                   -- print them
+                   | SNPrefer
+                   -- ^ Allow selector names on parsing, print them
+                   | SNRequire
+                   -- ^ Require selector names on parsing, print them
+  deriving (Show, Eq)
+
+-- | Printing and parsing options.
+data Options = Options { fieldSeparators :: NonEmpty Char
+                       -- ^ Separators between fields
+                       , recordSeparators :: NonEmpty Char
+                       -- ^ Separators between records (which may
+                       -- correspond to lines)
+                       , conNameMod :: String -> String
+                       -- ^ Constructor name modifier
+                       , selNameMod :: String -> String
+                       -- ^ Record selector name modifier
+                       , selNamePolicy :: SelNamePolicy
+                       , timeLocale :: TimeLocale
+                       , dateFormat :: String
+                       -- ^ See "Data.Time.Format".
+                       , timeFormat :: String
+                       , dateTimeFormat :: String
+                       , scientificFormat :: FPFormat
+                       , scientificDecimals :: Maybe Int
+                       , uriUserInfo :: String -> String
+                       -- ^ Used to map userinfo parts of URIs.
+                       }
+
+-- | Default options.
+defOpt :: Options
+defOpt = Options (' ' :| ['\t']) ('\n' :| [])
+  (map toLower) (("--" ++) . map toLower) SNAvoid
+  defaultTimeLocale (iso8601DateFormat Nothing) "%H:%M:%S"
+  (iso8601DateFormat (Just "%H:%M:%S")) Generic Nothing id
+
+parseDSV :: Parser a -> String -> Either String a
+parseDSV p s = case parse p "DSV" s of
+  Left err -> Left $ show err
+  Right x -> Right x
+
+-- | Parse a single record from a string.
+fromDSV :: Coalpit a => Options -> String -> Either String a
+fromDSV opt str = parseDSV (coalpitParser opt) str
+
+-- | Parse multiple records from a string.
+fromDSVList :: Coalpit a => Options -> String -> Either String [a]
+fromDSVList opt str =
+  parseDSV (coalpitParser opt `sepEndBy` pRecordSep opt) str
+
+escape :: Options -> String -> String
+escape opt str
+  | not (null str) &&
+    all (\fs -> not (fs `elem` str))
+    ('\\'
+     : '\"'
+     : NE.toList (fieldSeparators opt)
+     ++ NE.toList (recordSeparators opt)) = str
+  | otherwise = '"' : escaped str ++ "\""
+  where
+    escaped :: String -> String
+    escaped [] = []
+    escaped (c:rest)
+      | c `elem` "\\\"" = '\\' : c : escaped rest
+      | otherwise = c : escaped rest
+
+-- | Build a record ("line") out of individual strings, escaping those
+-- if needed.
+dsvFromList :: Options -> [String] -> String
+dsvFromList opt l = intercalate [NE.head (fieldSeparators opt)]
+                    (map (escape opt) l)
+
+-- | Serialize a value.
+toDSV :: Coalpit a => Options -> a -> String
+toDSV opt x = dsvFromList opt (coalpitPrint opt x)
+
+-- | Serialize multiple values.
+toDSVList :: Coalpit a => Options -> [a] -> String
+toDSVList opt l =
+  concatMap (\x -> toDSV opt x ++ [NE.head (recordSeparators opt)]) l
+
+-- | Compose 'Usage' description.
+usage :: Coalpit a => Options -> Proxy a -> Usage
+usage opt = coalpitDescription opt []
+
+-- | Compose a usage string.
+usageString :: Coalpit a => Options -> Proxy a -> String
+usageString opt = usageToString . usage opt
+
+-- | Translate 'Usage' into a string, used by 'usageString'.
+usageToString :: Usage -> String
+usageToString (UConstructor c) = c
+usageToString (URecursive c) = c ++ "..."
+usageToString (USelector False s u) = "[" ++ s ++ "] " ++ usageToString u
+usageToString (USelector True s u) = s ++ " " ++ usageToString u
+usageToString (UOptional u) = "[" ++ usageToString u ++ "]"
+usageToString (USum ul ur) = concat [ "("
+                                    , usageToString ul
+                                    , " | "
+                                    , usageToString ur
+                                    , ")"]
+usageToString (UProduct u1 UUnit) = usageToString u1
+usageToString (UProduct u1 u2) = usageToString u1 ++ " " ++ usageToString u2
+usageToString UUnit = ""
+usageToString (UType t) = t
+
+pFieldSep :: Options -> Parsec String m ()
+pFieldSep opt =
+  oneOf (NE.toList $ fieldSeparators opt) *> pure ()
+
+pRecordSep :: Options -> Parsec String m ()
+pRecordSep opt =
+  choice (eof
+          : map (\c -> char c *> pure ())
+           (NE.toList $ recordSeparators opt))
+
+pString :: Options -> Parsec String m String
+pString opt =
+  (try (quotedString <?> "quoted string"))
+  <|> (unquotedString <?> "unquoted string")
+  where
+    endChars = NE.toList (fieldSeparators opt)
+               ++ NE.toList (recordSeparators opt)
+    unquotedString = do
+      c <- escapedChar endChars
+      s <- manyTill (escapedChar endChars)
+        (lookAhead $ eof <|> oneOf endChars *> pure ())
+      pure (c:s)
+    escapedChar ecs = (char '\\' *> oneOf ('\\' : ecs)) <|> anyChar
+    quotedString = char '"'
+      *> manyTill (escapedChar "\"") (char '"')
+
+-- | Parses a time argument.
+pTime :: ParseTime a => Options -> String -> Parser a
+pTime opt tf = try $ do
+    x <- pString opt
+    case readSTime False (timeLocale opt) tf x of
+      [(t, "")] -> pure t
+      _ -> fail "Failed to parse time"
+
+-- | Read an argument using its 'Read' instance.
+pRead :: Read a => Options -> Parser a
+pRead opt = do
+  x <- pString opt
+  case reads x of
+    [(n, "")] -> pure n
+    _ -> fail $ "Failed to read: " ++ x
+
+-- | Coalpit class: parsing, printing, usage strings.
+class Coalpit a where
+  coalpitParser :: Options -> Parser a
+  default coalpitParser :: (Generic a, GCoalpit (Rep a)) => Options -> Parser a
+  coalpitParser opt = to <$> gCoalpitParser opt
+
+  coalpitPrint :: Options -> a -> [String]
+  default coalpitPrint :: (Generic a, GCoalpit (Rep a)) => Options -> a -> [String]
+  coalpitPrint opt a = gCoalpitPrint opt (from a)
+
+  coalpitDescription :: Options -> [String] -> Proxy a -> Usage
+  default coalpitDescription :: (GCoalpit (Rep a))
+                    => Options -> [String] -> Proxy a -> Usage
+  coalpitDescription opt path Proxy =
+    gCoalpitDescription opt path (Proxy :: Proxy (Rep a p))
+
+class GCoalpit a where
+  gCoalpitParser :: Options -> Parser (a p)
+  gCoalpitPrint :: Options -> a p -> [String]
+  gCoalpitDescription :: Options -> [String] -> Proxy (a p) -> Usage
+
+
+-- Units
+instance GCoalpit U1 where
+  gCoalpitParser _ = pure U1
+  gCoalpitPrint _ U1 = []
+  gCoalpitDescription _ _ (Proxy :: Proxy (U1 f)) = UUnit
+
+
+-- Products
+instance (GCoalpit a, GCoalpit b) => GCoalpit (a :*: b) where
+  gCoalpitParser opt =
+    ((:*:) <$>
+     (gCoalpitParser opt <* pFieldSep opt) <*> gCoalpitParser opt)
+    <?> "product"
+  gCoalpitPrint opt (x :*: y) =
+    gCoalpitPrint opt x ++ gCoalpitPrint opt y
+  gCoalpitDescription opt path (Proxy :: Proxy ((a :*: b) p)) =
+    UProduct (gCoalpitDescription opt path (Proxy :: Proxy (a p)))
+    (gCoalpitDescription opt path (Proxy :: Proxy (b p)))
+
+
+-- Sums
+instance
+  (GCoalpit a, GCoalpit b) => GCoalpit (a :+: b) where
+  gCoalpitParser opt =
+    (try (L1 <$> gCoalpitParser opt))
+    <|>
+    (R1 <$> gCoalpitParser opt)
+  gCoalpitPrint opt (L1 x) = gCoalpitPrint opt x
+  gCoalpitPrint opt (R1 x) = gCoalpitPrint opt x
+  gCoalpitDescription opt path (Proxy :: Proxy ((a :+: b) p)) =
+      USum (gCoalpitDescription opt path (Proxy :: Proxy (a p)))
+       (gCoalpitDescription opt path (Proxy :: Proxy (b p)))
+
+-- Record Selectors
+
+parseS1 :: (GCoalpit a) => String -> Options -> Parser (S1 selA a p)
+parseS1 nameA opt =
+  let sName = case (nameA, selNamePolicy opt) of
+        ("", _) -> pure ()
+        (_, SNDisable) -> pure ()
+        (_, SNRequire) -> string (selNameMod opt nameA) *> pFieldSep opt
+        (_, _) -> optional
+          (try $ (string (selNameMod opt nameA)) *> pFieldSep opt)
+  in M1 <$> (sName *> gCoalpitParser opt)
+
+printS1 :: (GCoalpit a, Selector selA) => Options -> S1 selA a p -> [String]
+printS1 opt sel@(M1 x) = case (selName sel, selNamePolicy opt) of
+                           ("", _) -> gCoalpitPrint opt x
+                           (_, SNDisable) -> gCoalpitPrint opt x
+                           (_, SNAvoid) -> gCoalpitPrint opt x
+                           (name, _) -> selNameMod opt name : gCoalpitPrint opt x
+
+helpS1 :: (GCoalpit a)
+       => String -> Options -> [String] -> Proxy (S1 selA a p) -> Usage
+helpS1 nameA opt path (Proxy :: Proxy (S1 selA a p)) =
+  case (nameA, selNamePolicy opt) of
+    ("", _) -> gCoalpitDescription opt path (Proxy :: Proxy (a p))
+    (_, SNDisable) -> gCoalpitDescription opt path (Proxy :: Proxy (a p))
+    (_, snpol) -> USelector (snpol == SNRequire) (selNameMod opt nameA)
+      (gCoalpitDescription opt path (Proxy :: Proxy (a p)))
+
+instance (GCoalpit a, Selector selA) => GCoalpit (S1 selA a) where
+  gCoalpitParser = parseS1 (selName (undefined :: S1 selA a p))
+  gCoalpitPrint = printS1
+  gCoalpitDescription = helpS1 (selName (undefined :: S1 selA a p))
+
+-- Constructors
+
+-- | Handles recursive constructors.
+handleRecCon :: GCoalpit a
+             => String
+             -- ^ Constructor name
+             -> Options
+             -> [String]
+             -> Proxy (a p)
+             -> Usage
+handleRecCon nameA opt path (Proxy :: Proxy (a p)) =
+  let n = conNameMod opt nameA
+  in if nameA `elem` path
+     then URecursive n
+     else UProduct (UConstructor n)
+          (gCoalpitDescription opt (nameA : path) (Proxy :: Proxy (a p)))
+
+-- A constructor wrapping just a unit: no field separator is required
+-- after such a constructor.
+instance {-#OVERLAPPING#-} (Constructor conA) => GCoalpit (C1 conA U1) where
+  gCoalpitParser opt =
+    ((string
+       (conNameMod opt $ conName (undefined :: C1 conA U1 w))
+       <?> "constructor name"))
+    *> (fmap M1 (gCoalpitParser opt))
+  gCoalpitPrint opt (M1 x) = conNameMod opt (conName (undefined :: C1 conA U1 w))
+                       : gCoalpitPrint opt x
+  gCoalpitDescription opt path (Proxy :: Proxy (C1 conA U1 p)) =
+    (handleRecCon (conName (undefined :: C1 conA U1 w)) opt path
+     (Proxy :: Proxy (U1 p)))
+
+-- A constructor with non-unit children, with a field separator
+-- between constructor name and its children.
+instance (GCoalpit a, Constructor conA) => GCoalpit (C1 conA a) where
+  gCoalpitParser opt =
+    ((string
+       (conNameMod opt $ conName (undefined :: C1 conA a w))
+       <?> "constructor name"))
+    *> (pFieldSep opt)
+    *> (fmap M1 (gCoalpitParser opt))
+  gCoalpitPrint opt (M1 x) = conNameMod opt (conName (undefined :: C1 conA a w))
+                       : gCoalpitPrint opt x
+  gCoalpitDescription opt path (Proxy :: Proxy (C1 conA a p)) =
+    (handleRecCon (conName (undefined :: C1 conA a w)) opt path
+     (Proxy :: Proxy (a p)))
+
+-- Data types
+instance (GCoalpit a) => GCoalpit (D1 conA a) where
+  gCoalpitParser = fmap M1 . gCoalpitParser
+  gCoalpitPrint opt (M1 x) = gCoalpitPrint opt x
+  gCoalpitDescription opt path (Proxy :: Proxy (D1 conA a p)) =
+    gCoalpitDescription opt path (Proxy :: Proxy (a p))
+
+-- Constraints and such
+instance (Coalpit a) => GCoalpit (K1 i a) where
+  gCoalpitParser = fmap K1 . coalpitParser
+  gCoalpitPrint opt (K1 x) = coalpitPrint opt x
+  gCoalpitDescription opt path (Proxy :: Proxy (K1 x a p)) =
+    coalpitDescription opt path (Proxy :: Proxy a)
+
+
+-- Common types
+
+instance Coalpit Int where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "INT"
+
+instance Coalpit Integer where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "INTEGER"
+
+instance Coalpit Word8 where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "WORD8"
+
+instance Coalpit Word16 where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "WORD16"
+
+instance Coalpit Word32 where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "WORD32"
+
+instance Coalpit Word64 where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "WORD64"
+
+instance Coalpit Int8 where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "INT8"
+
+instance Coalpit Int16 where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "INT16"
+
+instance Coalpit Int32 where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "INT32"
+
+instance Coalpit Int64 where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "INT64"
+
+instance Coalpit Natural where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "NATURAL"
+
+instance Coalpit Rational where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "RATIONAL"
+
+instance Coalpit Double where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "DOUBLE"
+
+instance Coalpit Float where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ i = [show i]
+  coalpitDescription _ _ _ = UType "FLOAT"
+
+instance Coalpit Char where
+  coalpitParser opt = pRead opt
+  coalpitPrint _ c = [show c]
+  coalpitDescription _ _ _ = UType "CHAR"
+
+
+instance {-#OVERLAPPING#-} Coalpit String where
+  coalpitParser opt = pString opt
+  coalpitPrint _ i = [i]
+  coalpitDescription _ _ _ = UType "STRING"
+
+instance Coalpit Scientific where
+  coalpitParser opt = try $ do
+    x <- pString opt
+    case reverse $ readP_to_S scientificP x of
+      (n, ""):_ -> pure n
+      _ -> fail $ "Failed to read a scientific number: " ++ x
+  coalpitPrint opt n = [formatScientific
+                  (scientificFormat opt) (scientificDecimals opt) n]
+  coalpitDescription _ _ _ = UType "SCIENTIFIC"
+
+instance Coalpit Version where
+  coalpitParser opt = try $ do
+    x <- pString opt
+    case reverse $ readP_to_S parseVersion x of
+      (v, ""):_ -> pure v
+      _ -> fail $ "Failed to read a version: " ++ x
+  coalpitPrint _ v = [showVersion v]
+  coalpitDescription _ _ _ = UType "VERSION"
+
+
+-- | An URI reference (absolute or relative).
+instance Coalpit URI where
+  coalpitParser opt = try $ do
+    x <- pString opt
+    maybe (fail $ "Failed to parse URI: " ++ x) pure (parseURIReference x)
+  coalpitPrint opt u = [uriToString (uriUserInfo opt) u ""]
+  coalpitDescription _ _ _ = UType "URI"
+
+
+-- | Uses 'dateTimeFormat'.
+instance Coalpit UTCTime where
+  coalpitParser opt = pTime opt (dateTimeFormat opt)
+  coalpitPrint opt t = [formatTime (timeLocale opt) (dateTimeFormat opt) t]
+  coalpitDescription _ _ _ = UType "UTC_TIME"
+
+-- | Uses 'dateTimeFormat'.
+instance Coalpit ZonedTime where
+  coalpitParser opt = pTime opt (dateTimeFormat opt)
+  coalpitPrint opt t = [formatTime (timeLocale opt) (dateTimeFormat opt) t]
+  coalpitDescription _ _ _ = UType "ZONED_TIME"
+
+-- | Uses 'dateTimeFormat'.
+instance Coalpit LocalTime where
+  coalpitParser opt = pTime opt (dateTimeFormat opt)
+  coalpitPrint opt t = [formatTime (timeLocale opt) (dateTimeFormat opt) t]
+  coalpitDescription _ _ _ = UType "LOCAL_TIME"
+
+-- | Uses 'dateTimeFormat'.
+instance Coalpit UniversalTime where
+  coalpitParser opt = pTime opt (dateTimeFormat opt)
+  coalpitPrint opt t = [formatTime (timeLocale opt) (dateTimeFormat opt) t]
+  coalpitDescription _ _ _ = UType "UNIVERSAL_TIME"
+
+-- | Uses 'timeFormat'.
+instance Coalpit TimeOfDay where
+  coalpitParser opt = pTime opt (timeFormat opt)
+  coalpitPrint opt t = [formatTime (timeLocale opt) (timeFormat opt) t]
+  coalpitDescription _ _ _ = UType "TIME_OF_DAY"
+
+-- | Uses 'dateFormat'.
+instance Coalpit Day where
+  coalpitParser opt = pTime opt (dateFormat opt)
+  coalpitPrint opt t = [formatTime (timeLocale opt) (dateFormat opt) t]
+  coalpitDescription _ _ _ = UType "DAY"
+
+-- | Converts to/from 'Scientific'.
+instance Coalpit NominalDiffTime where
+  coalpitParser opt = fromRational . toRational
+                  <$> (coalpitParser opt :: Parser Scientific)
+  coalpitPrint opt = coalpitPrint opt .
+    (fromRational . toRational :: NominalDiffTime -> Scientific)
+  coalpitDescription _ _ _ = UType "NOMINAL_DIFF_TIME"
+
+-- | Converts to/from 'Scientific'.
+instance Coalpit DiffTime where
+  coalpitParser opt = fromRational . toRational
+                  <$> (coalpitParser opt :: Parser Scientific)
+  coalpitPrint opt = coalpitPrint opt .
+    (fromRational . toRational :: DiffTime -> Scientific)
+  coalpitDescription _ _ _ = UType "DIFF_TIME"
 
-import Coalpit.Core
-import Coalpit.DSV
+instance Coalpit ()
+instance Coalpit Bool
+instance Coalpit Ordering
+instance Coalpit ExitCode
+instance Coalpit a => Coalpit (Complex a)
+instance Coalpit a => Coalpit (Maybe a)
+instance Coalpit a => Coalpit [a]
+instance Coalpit a => Coalpit (NonEmpty a)
+instance (Coalpit a, Coalpit b) => Coalpit (Either a b)
+instance (Coalpit a, Coalpit b) => Coalpit (a, b)
+instance (Coalpit a, Coalpit b, Coalpit c) => Coalpit (a, b, c)
+instance (Coalpit a, Coalpit b, Coalpit c, Coalpit d) => Coalpit (a, b, c, d)
-- 
cgit v1.2.3