{-# LANGUAGE DefaultSignatures, ScopedTypeVariables #-}
module Frames.ColumnTypeable where
import Control.Monad (MonadPlus)
import Data.Maybe (fromMaybe)
import Data.Readable (Readable(fromText))
import Data.Typeable (Proxy(..), typeRep, Typeable)
import qualified Data.Text as T
import Data.Int (Int32, Int64)
import Data.Vinyl.Functor (Const(..))
import Language.Haskell.TH

data Parsed a = Possibly a | Definitely a deriving (Parsed a -> Parsed a -> Bool
forall a. Eq a => Parsed a -> Parsed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parsed a -> Parsed a -> Bool
$c/= :: forall a. Eq a => Parsed a -> Parsed a -> Bool
== :: Parsed a -> Parsed a -> Bool
$c== :: forall a. Eq a => Parsed a -> Parsed a -> Bool
Eq, Parsed a -> Parsed a -> Bool
Parsed a -> Parsed a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Parsed a)
forall a. Ord a => Parsed a -> Parsed a -> Bool
forall a. Ord a => Parsed a -> Parsed a -> Ordering
forall a. Ord a => Parsed a -> Parsed a -> Parsed a
min :: Parsed a -> Parsed a -> Parsed a
$cmin :: forall a. Ord a => Parsed a -> Parsed a -> Parsed a
max :: Parsed a -> Parsed a -> Parsed a
$cmax :: forall a. Ord a => Parsed a -> Parsed a -> Parsed a
>= :: Parsed a -> Parsed a -> Bool
$c>= :: forall a. Ord a => Parsed a -> Parsed a -> Bool
> :: Parsed a -> Parsed a -> Bool
$c> :: forall a. Ord a => Parsed a -> Parsed a -> Bool
<= :: Parsed a -> Parsed a -> Bool
$c<= :: forall a. Ord a => Parsed a -> Parsed a -> Bool
< :: Parsed a -> Parsed a -> Bool
$c< :: forall a. Ord a => Parsed a -> Parsed a -> Bool
compare :: Parsed a -> Parsed a -> Ordering
$ccompare :: forall a. Ord a => Parsed a -> Parsed a -> Ordering
Ord, Int -> Parsed a -> ShowS
forall a. Show a => Int -> Parsed a -> ShowS
forall a. Show a => [Parsed a] -> ShowS
forall a. Show a => Parsed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parsed a] -> ShowS
$cshowList :: forall a. Show a => [Parsed a] -> ShowS
show :: Parsed a -> String
$cshow :: forall a. Show a => Parsed a -> String
showsPrec :: Int -> Parsed a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Parsed a -> ShowS
Show)

parsedValue :: Parsed a -> a
parsedValue :: forall a. Parsed a -> a
parsedValue (Possibly a
a) = a
a
parsedValue (Definitely a
a) = a
a

instance Functor Parsed where
  fmap :: forall a b. (a -> b) -> Parsed a -> Parsed b
fmap a -> b
f (Possibly a
x) = forall a. a -> Parsed a
Possibly (a -> b
f a
x)
  fmap a -> b
f (Definitely a
x) = forall a. a -> Parsed a
Definitely (a -> b
f a
x)

-- | Values that can be read from a 'T.Text' with more or less
-- discrimination.
class Parseable a where
  -- | Returns 'Nothing' if a value of the given type can not be read;
  -- returns 'Just Possibly' if a value can be read, but is likely
  -- ambiguous (e.g. an empty string); returns 'Just Definitely' if a
  -- value can be read and is unlikely to be ambiguous."
  parse :: MonadPlus m => T.Text -> m (Parsed a)
  default parse :: (Readable a, MonadPlus m)
                => T.Text -> m (Parsed a)
  parse = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Parsed a
Definitely forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Readable a, MonadPlus m) => Text -> m a
fromText
  {-# INLINE parse #-}

  -- | Combine two parse results such that the combination can
  -- fail. Useful when we have two 'Possibly' parsed values that are
  -- different enough to suggest the parse of each should be
  -- considered a failure. The default implementation is to 'return'
  -- the first argument.
  parseCombine :: MonadPlus m => Parsed a -> Parsed a -> m (Parsed a)
  default parseCombine :: MonadPlus m => Parsed a -> Parsed a -> m (Parsed a)
  parseCombine = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

  representableAsType :: Parsed a -> Const (Either (String -> Q [Dec]) Type) a
  default
    representableAsType :: Typeable a
                        => Parsed a -> Const (Either (String -> Q [Dec]) Type) a
  representableAsType =
    forall a b. a -> b -> a
const (forall k a (b :: k). a -> Const a b
Const (forall a b. b -> Either a b
Right (Name -> Type
ConT (String -> Name
mkName (forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)))))))

-- | Discard any estimate of a parse's ambiguity.
discardConfidence :: Parsed a -> a
discardConfidence :: forall a. Parsed a -> a
discardConfidence (Possibly a
x) = a
x
discardConfidence (Definitely a
x) = a
x

-- | Acts just like 'fromText': tries to parse a value from a 'T.Text'
-- and discards any estimate of the parse's ambiguity.
parse' :: (MonadPlus m, Parseable a) => T.Text -> m a
parse' :: forall (m :: * -> *) a. (MonadPlus m, Parseable a) => Text -> m a
parse' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Parsed a -> a
discardConfidence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *).
(Parseable a, MonadPlus m) =>
Text -> m (Parsed a)
parse

parseIntish :: (Readable a, MonadPlus f) => T.Text -> f (Parsed a)
parseIntish :: forall a (f :: * -> *).
(Readable a, MonadPlus f) =>
Text -> f (Parsed a)
parseIntish Text
t =
  forall a. a -> Parsed a
Definitely forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Readable a, MonadPlus m) => Text -> m a
fromText (forall a. a -> Maybe a -> a
fromMaybe Text
t (Text -> Text -> Maybe Text
T.stripSuffix (String -> Text
T.pack String
".0") Text
t))

instance Parseable Bool where

instance Parseable Int where
  parse :: forall (m :: * -> *). MonadPlus m => Text -> m (Parsed Int)
parse = forall a (f :: * -> *).
(Readable a, MonadPlus f) =>
Text -> f (Parsed a)
parseIntish
instance Parseable Int32 where
  parse :: forall (m :: * -> *). MonadPlus m => Text -> m (Parsed Int32)
parse = forall a (f :: * -> *).
(Readable a, MonadPlus f) =>
Text -> f (Parsed a)
parseIntish
instance Parseable Int64 where
  parse :: forall (m :: * -> *). MonadPlus m => Text -> m (Parsed Int64)
parse = forall a (f :: * -> *).
(Readable a, MonadPlus f) =>
Text -> f (Parsed a)
parseIntish
instance Parseable Integer where
  parse :: forall (m :: * -> *). MonadPlus m => Text -> m (Parsed Integer)
parse = forall a (f :: * -> *).
(Readable a, MonadPlus f) =>
Text -> f (Parsed a)
parseIntish

instance Parseable Float where
instance Parseable Double where
  -- Some CSV's export Doubles in a format like '1,000.00', filtering
  -- out commas lets us parse those sucessfully
  parse :: forall (m :: * -> *). MonadPlus m => Text -> m (Parsed Double)
parse = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Parsed a
Definitely forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Readable a, MonadPlus m) => Text -> m a
fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/= Char
',')
instance Parseable T.Text where

-- | This class relates a universe of possible column types to Haskell
-- types, and provides a mechanism to infer which type best represents
-- some textual data.
class ColumnTypeable a where
  colType :: a -> Either (String -> Q [Dec]) Type
  inferType :: T.Text -> a